home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tcl7.4 / tclGlob.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-06-08  |  11.4 KB  |  431 lines
  1. /* 
  2.  * tclGlob.c --
  3.  *
  4.  *    This file provides procedures and commands for file name
  5.  *    manipulation, such as tilde expansion and globbing.
  6.  *
  7.  * Copyright (c) 1990-1994 The Regents of the University of California.
  8.  * Copyright (c) 1994 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  */
  13.  
  14. #ifndef lint
  15. static char sccsid[] = "@(#) tclGlob.c 1.42 95/06/08 10:56:13";
  16. #endif /* not lint */
  17.  
  18. #include "tclInt.h"
  19. #include "tclPort.h"
  20.  
  21. /*
  22.  * Declarations for procedures local to this file:
  23.  */
  24.  
  25. static int        DoGlob _ANSI_ARGS_((Tcl_Interp *interp, char *dir,
  26.                 char *rem));
  27.  
  28. /*
  29.  *----------------------------------------------------------------------
  30.  *
  31.  * DoGlob --
  32.  *
  33.  *    This recursive procedure forms the heart of the globbing
  34.  *    code.  It performs a depth-first traversal of the tree
  35.  *    given by the path name to be globbed.
  36.  *
  37.  * Results:
  38.  *    The return value is a standard Tcl result indicating whether
  39.  *    an error occurred in globbing.  After a normal return the
  40.  *    result in interp will be set to hold all of the file names
  41.  *    given by the dir and rem arguments.  After an error the
  42.  *    result in interp will hold an error message.
  43.  *
  44.  * Side effects:
  45.  *    None.
  46.  *
  47.  *----------------------------------------------------------------------
  48.  */
  49.  
  50. static int
  51. DoGlob(interp, dir, rem)
  52.     Tcl_Interp *interp;            /* Interpreter to use for error
  53.                      * reporting (e.g. unmatched brace). */
  54.     char *dir;                /* Name of a directory at which to
  55.                      * start glob expansion.  This name
  56.                      * is fixed: it doesn't contain any
  57.                      * globbing chars. */
  58.     char *rem;                /* Path to glob-expand. */
  59. {
  60.     /*
  61.      * When this procedure is entered, the name to be globbed may
  62.      * already have been partly expanded by ancestor invocations of
  63.      * DoGlob.  The part that's already been expanded is in "dir"
  64.      * (this may initially be empty), and the part still to expand
  65.      * is in "rem".  This procedure expands "rem" one level, making
  66.      * recursive calls to itself if there's still more stuff left
  67.      * in the remainder.
  68.      */
  69.  
  70.     Tcl_DString newName;        /* Holds new name consisting of
  71.                      * dir plus the first part of rem. */
  72.     register char *p;
  73.     register char c;
  74.     char *openBrace, *closeBrace, *name, *dirName;
  75.     int gotSpecial, baseLength;
  76.     int result = TCL_OK;
  77.     struct stat statBuf;
  78.  
  79.     /*
  80.      * Make sure that the directory part of the name really is a
  81.      * directory.  If the directory name is "", use the name "."
  82.      * instead, because some UNIX systems don't treat "" like "."
  83.      * automatically. Keep the "" for use in generating file names,
  84.      * otherwise "glob foo.c" would return "./foo.c".
  85.      */
  86.  
  87.     if (*dir == '\0') {
  88.     dirName = ".";
  89.     } else {
  90.     dirName = dir;
  91.     }
  92.     if ((stat(dirName, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
  93.     return TCL_OK;
  94.     }
  95.     Tcl_DStringInit(&newName);
  96.  
  97.     /*
  98.      * First, find the end of the next element in rem, checking
  99.      * along the way for special globbing characters.
  100.      */
  101.  
  102.     gotSpecial = 0;
  103.     openBrace = closeBrace = NULL;
  104.     for (p = rem; ; p++) {
  105.     c = *p;
  106.     if ((c == '\0') || ((openBrace == NULL) && (c == '/'))) {
  107.         break;
  108.     }
  109.     if ((c == '{') && (openBrace == NULL)) {
  110.         openBrace = p;
  111.     }
  112.     if ((c == '}') && (openBrace != NULL) && (closeBrace == NULL)) {
  113.         closeBrace = p;
  114.     }
  115.     if ((c == '*') || (c == '[') || (c == '\\') || (c == '?')) {
  116.         gotSpecial = 1;
  117.     }
  118.     }
  119.  
  120.     /*
  121.      * If there is an open brace in the argument, then make a recursive
  122.      * call for each element between the braces.  In this case, the
  123.      * recursive call to DoGlob uses the same "dir" that we got.
  124.      * If there are several brace-pairs in a single name, we just handle
  125.      * one here, and the others will be handled in recursive calls.
  126.      */
  127.  
  128.     if (openBrace != NULL) {
  129.     char *element;
  130.  
  131.     if (closeBrace == NULL) {
  132.         Tcl_ResetResult(interp);
  133.         interp->result = "unmatched open-brace in file name";
  134.         result = TCL_ERROR;
  135.         goto done;
  136.     }
  137.     Tcl_DStringAppend(&newName, rem, openBrace-rem);
  138.     baseLength = newName.length;
  139.     for (p = openBrace; *p != '}'; ) {
  140.         element = p+1;
  141.         for (p = element; ((*p != '}') && (*p != ',')); p++) {
  142.         /* Empty loop body. */
  143.         }
  144.         Tcl_DStringAppend(&newName, element, p-element);
  145.         Tcl_DStringAppend(&newName, closeBrace+1, -1);
  146.         result = DoGlob(interp, dir, newName.string);
  147.         if (result != TCL_OK) {
  148.         goto done;
  149.         }
  150.         newName.length = baseLength;
  151.     }
  152.     goto done;
  153.     }
  154.  
  155.     /*
  156.      * Start building up the next-level name with dir plus a slash if
  157.      * needed to separate it from the next file name.
  158.      */
  159.  
  160.     Tcl_DStringAppend(&newName, dir, -1);
  161.     if ((dir[0] != 0) && (newName.string[newName.length-1] != '/')) {
  162.     Tcl_DStringAppend(&newName, "/", 1);
  163.     }
  164.     baseLength = newName.length;
  165.  
  166.     /*
  167.      * If there were any pattern-matching characters, then scan through
  168.      * the directory to find all the matching names.
  169.      */
  170.  
  171.     if (gotSpecial) {
  172.     DIR *d;
  173.     struct dirent *entryPtr;
  174.     char savedChar;
  175.  
  176.     d = opendir(dirName);
  177.     if (d == NULL) {
  178.         Tcl_ResetResult(interp);
  179.         Tcl_AppendResult(interp, "couldn't read directory \"",
  180.             dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
  181.         result = TCL_ERROR;
  182.         goto done;
  183.     }
  184.  
  185.     /*
  186.      * Temporarily store a null into rem so that the pattern string
  187.      * is now null-terminated.
  188.      */
  189.  
  190.     savedChar = *p;
  191.     *p = 0;
  192.  
  193.     while (1) {
  194.         entryPtr = readdir(d);
  195.         if (entryPtr == NULL) {
  196.         break;
  197.         }
  198.  
  199.         /*
  200.          * Don't match names starting with "." unless the "." is
  201.          * present in the pattern.
  202.          */
  203.  
  204.         if ((*entryPtr->d_name == '.') && (*rem != '.')) {
  205.         continue;
  206.         }
  207.         if (Tcl_StringMatch(entryPtr->d_name, rem)) {
  208.         newName.length = baseLength;
  209.         Tcl_DStringAppend(&newName, entryPtr->d_name, -1);
  210.         if (savedChar == 0) {
  211.             Tcl_AppendElement(interp, newName.string);
  212.         } else {
  213.             result = DoGlob(interp, newName.string, p+1);
  214.             if (result != TCL_OK) {
  215.             break;
  216.             }
  217.         }
  218.         }
  219.     }
  220.     closedir(d);
  221.     *p = savedChar;
  222.     goto done;
  223.     }
  224.  
  225.     /*
  226.      * The current element is a simple one with no fancy features.  Add
  227.      * it to the new name.  If there are more elements still to come,
  228.      * then recurse to process them.
  229.      */
  230.  
  231.     Tcl_DStringAppend(&newName, rem, p-rem);
  232.     if (*p != 0) {
  233.     result = DoGlob(interp, newName.string, p+1);
  234.     goto done;
  235.     }
  236.  
  237.     /*
  238.      * There are no more elements in the pattern.  Check to be sure the
  239.      * file actually exists, then add its name to the list being formed
  240.      * in interp-result.
  241.      */
  242.  
  243.     name = newName.string;
  244.     if (*name == 0) {
  245.     name = ".";
  246.     }
  247.     if (access(name, F_OK) != 0) {
  248.     goto done;
  249.     }
  250.     Tcl_AppendElement(interp, name);
  251.  
  252.     done:
  253.     Tcl_DStringFree(&newName);
  254.     return result;
  255. }
  256.  
  257. /*
  258.  *----------------------------------------------------------------------
  259.  *
  260.  * Tcl_TildeSubst --
  261.  *
  262.  *    Given a name starting with a tilde, produce a name where
  263.  *    the tilde and following characters have been replaced by
  264.  *    the home directory location for the named user.
  265.  *
  266.  * Results:
  267.  *    The result is a pointer to a static string containing
  268.  *    the new name.  If there was an error in processing the
  269.  *    tilde, then an error message is left in interp->result
  270.  *    and the return value is NULL.  The result may be stored
  271.  *    in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
  272.  *    to free the name.
  273.  *
  274.  * Side effects:
  275.  *    Information may be left in bufferPtr.
  276.  *
  277.  *----------------------------------------------------------------------
  278.  */
  279.  
  280. char *
  281. Tcl_TildeSubst(interp, name, bufferPtr)
  282.     Tcl_Interp *interp;        /* Interpreter in which to store error
  283.                  * message (if necessary). */
  284.     char *name;            /* File name, which may begin with "~/"
  285.                  * (to indicate current user's home directory)
  286.                  * or "~<user>/" (to indicate any user's
  287.                  * home directory). */
  288.     Tcl_DString *bufferPtr;    /* May be used to hold result.  Must not hold
  289.                  * anything at the time of the call, and need
  290.                  * not even be initialized. */
  291. {
  292.     char *dir;
  293.     register char *p;
  294.  
  295.     Tcl_DStringInit(bufferPtr);
  296.     if (name[0] != '~') {
  297.     return name;
  298.     }
  299.  
  300.     if ((name[1] == '/') || (name[1] == '\0')) {
  301.     dir = getenv("HOME");
  302.     if (dir == NULL) {
  303.         Tcl_ResetResult(interp);
  304.         Tcl_AppendResult(interp, "couldn't find HOME environment ",
  305.             "variable to expand \"", name, "\"", (char *) NULL);
  306.         return NULL;
  307.     }
  308.     Tcl_DStringAppend(bufferPtr, dir, -1);
  309.     Tcl_DStringAppend(bufferPtr, name+1, -1);
  310.     } else {
  311.     struct passwd *pwPtr;
  312.  
  313.     for (p = &name[1]; (*p != 0) && (*p != '/'); p++) {
  314.         /* Null body;  just find end of name. */
  315.     }
  316.     Tcl_DStringAppend(bufferPtr, name+1, p - (name+1));
  317.     pwPtr = getpwnam(bufferPtr->string);
  318.     if (pwPtr == NULL) {
  319.         endpwent();
  320.         Tcl_ResetResult(interp);
  321.         Tcl_AppendResult(interp, "user \"", bufferPtr->string,
  322.             "\" doesn't exist", (char *) NULL);
  323.         Tcl_DStringFree(bufferPtr);
  324.         return NULL;
  325.     }
  326.     Tcl_DStringFree(bufferPtr);
  327.     Tcl_DStringAppend(bufferPtr, pwPtr->pw_dir, -1);
  328.     Tcl_DStringAppend(bufferPtr, p, -1);
  329.     endpwent();
  330.     }
  331.     return bufferPtr->string;
  332. }
  333.  
  334. /*
  335.  *----------------------------------------------------------------------
  336.  *
  337.  * Tcl_GlobCmd --
  338.  *
  339.  *    This procedure is invoked to process the "glob" Tcl command.
  340.  *    See the user documentation for details on what it does.
  341.  *
  342.  * Results:
  343.  *    A standard Tcl result.
  344.  *
  345.  * Side effects:
  346.  *    See the user documentation.
  347.  *
  348.  *----------------------------------------------------------------------
  349.  */
  350.  
  351.     /* ARGSUSED */
  352. int
  353. Tcl_GlobCmd(dummy, interp, argc, argv)
  354.     ClientData dummy;            /* Not used. */
  355.     Tcl_Interp *interp;            /* Current interpreter. */
  356.     int argc;                /* Number of arguments. */
  357.     char **argv;            /* Argument strings. */
  358. {
  359.     int i, result, noComplain, firstArg;
  360.  
  361.     if (argc < 2) {
  362.     notEnoughArgs:
  363.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  364.         " ?switches? name ?name ...?\"", (char *) NULL);
  365.     return TCL_ERROR;
  366.     }
  367.     noComplain = 0;
  368.     for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
  369.         firstArg++) {
  370.     if (strcmp(argv[firstArg], "-nocomplain") == 0) {
  371.         noComplain = 1;
  372.     } else if (strcmp(argv[firstArg], "--") == 0) {
  373.         firstArg++;
  374.         break;
  375.     } else {
  376.         Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
  377.             "\": must be -nocomplain or --", (char *) NULL);
  378.         return TCL_ERROR;
  379.     }
  380.     }
  381.     if (firstArg >= argc) {
  382.     goto notEnoughArgs;
  383.     }
  384.  
  385.     for (i = firstArg; i < argc; i++) {
  386.     char *thisName;
  387.     Tcl_DString buffer;
  388.  
  389.     thisName = Tcl_TildeSubst(interp, argv[i], &buffer);
  390.     if (thisName == NULL) {
  391.         if (noComplain) {
  392.         Tcl_ResetResult(interp);
  393.         continue;
  394.         } else {
  395.         return TCL_ERROR;
  396.         }
  397.     }
  398.     if (*thisName == '/') {
  399.         if (thisName[1] == '/') {
  400.         /*
  401.          * This is a special hack for systems like those from Apollo
  402.          * where there is a super-root at "//":  need to treat the
  403.          * double-slash as a single name.
  404.          */
  405.         result = DoGlob(interp, "//", thisName+2);
  406.         } else {
  407.         result = DoGlob(interp, "/", thisName+1);
  408.         }
  409.     } else {
  410.         result = DoGlob(interp, "", thisName);
  411.     }
  412.     Tcl_DStringFree(&buffer);
  413.     if (result != TCL_OK) {
  414.         return result;
  415.     }
  416.     }
  417.     if ((*interp->result == 0) && !noComplain) {
  418.     char *sep = "";
  419.  
  420.     Tcl_AppendResult(interp, "no files matched glob pattern",
  421.         (argc == 2) ? " \"" : "s \"", (char *) NULL);
  422.     for (i = firstArg; i < argc; i++) {
  423.         Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
  424.         sep = " ";
  425.     }
  426.     Tcl_AppendResult(interp, "\"", (char *) NULL);
  427.     return TCL_ERROR;
  428.     }
  429.     return TCL_OK;
  430. }
  431.